TableGetDouble Subroutine

private subroutine TableGetDouble(valueIn, tab, keyIn, keyOut, match, valueOut, bound)

Uses

returns a double from column defined by keyOut corresponding to valueIn contained in column defined by keyIn. Arguments: valueIn input value tab table to search in keyIn defines header of the column of the input value keyOut defines header of the column of the output value match method to match input value. Possible values are: 'exact' = column must contain exact input value 'linear' = calculates linear interpolation between two bounding values 'nearest' = search for the nearest value in input column bound method to manage bounds. Possible values are: 'fixed' = extreme values are treated as a wall 'extendlinear' = extend bounds with linear interpolation of last two extreme values 'extendconstant' = extend bounds preserving extreme value constant

Arguments

Type IntentOptional Attributes Name
real(kind=float), intent(in) :: valueIn
type(Table), intent(in) :: tab
character(len=*), intent(in) :: keyIn
character(len=*), intent(in) :: keyOut
character(len=*), intent(in) :: match
real(kind=double), intent(out) :: valueOut
character(len=*), intent(in), optional :: bound

Variables

Type Visibility Attributes Name Initial
real(kind=float), public :: bias
type(Column), public, POINTER :: colIn
type(Column), public, POINTER :: colOut
logical, public :: foundValue
integer(kind=short), public :: i
real(kind=float), public :: lowerIn
real(kind=double), public :: lowerOut
character(len=100), public :: string
real(kind=float), public :: upperIn
real(kind=double), public :: upperOut

Source Code

SUBROUTINE TableGetDouble &
!
( valueIn, tab, keyIn, keyOut, match, valueOut, bound )

! Module used:
USE StringManipulation, ONLY: &
! imported routines:
StringCompact, StringToUpper, StringToFloat, ToString, &
StringToDouble

USE LogLib, ONLY : &
! Imported Routines:
Catch

USE ErrorCodes, ONLY : &
! Imported parameters:
unknownOption


IMPLICIT NONE

! Function arguments
! Scalar arguments with intent(in):
REAL (KIND = float),  INTENT (IN) :: valueIn
CHARACTER (LEN = *),  INTENT (IN) :: keyIn
CHARACTER (LEN = *),  INTENT (IN) :: keyOut
CHARACTER (LEN = *),  INTENT (IN) :: match
CHARACTER (LEN = *),  OPTIONAL, INTENT (IN) :: bound

! Type defined arguments with intent (in):
TYPE (Table), INTENT (IN) :: tab

! Scalar arguments with intent(in):
REAL (KIND = double), INTENT (OUT) :: valueOut

! Local scalars:
TYPE (Column), POINTER :: colIn
TYPE (Column), POINTER :: colOut
INTEGER (KIND = short) :: i
CHARACTER (LEN = 100)  :: string
LOGICAL                :: foundValue
REAL (KIND = float)    :: upperIn
REAL (KIND = float)    :: lowerIn
REAL (KIND = double)   :: upperOut
REAL (KIND = double)   :: lowerOut
REAL (KIND = float)    :: bias

!------------end of declaration------------------------------------------------
!inizialization
foundValue = .FALSE.
!find columns to be processed
DO i = 1, tab % noCols
  string = StringCompact (StringToUpper (tab % col (i) % header) ) 
  IF ( string == StringToUpper(keyIn) ) THEN
    colIn => tab % col (i) !colIn is an alias of the input column
  ELSE IF ( string == StringToUpper(keyOut) ) THEN  
    colOut => tab % col (i) !colOut is an alias of the output column
  END IF 
END DO

SELECT CASE ( StringToUpper (match) )
  CASE ('EXACT')
    !bound method is not necessary, only fixed makes sense.
    DO i = 1, tab % noRows
      IF ( StringToFloat (colIn % row (i)) == valueIn ) THEN
        foundValue = .TRUE.
        valueOut = StringToDouble (colout % row (i))
      END IF
    END DO
    IF ( .NOT. foundValue ) THEN
      CALL Catch ('error', 'TableLib',   &
           TRIM ( ToString (valueIn) ) // ' not found in table: ' ,  &
		    argument = tab % id )
    END IF
  CASE ('LINEAR')
    !if bound is not specified, assume FIXED 
    IF (.NOT. PRESENT (bound) ) THEN
      IF ( StringToFloat (colIn % row (1)) > valueIn .OR. &
           StringToFloat (colIn % row (tab % noRows) ) < valueIn ) THEN
        CALL Catch ('error', 'TableLib', 'bounds exceeded in table: ',  &
			         argument = TRIM(tab % Id) )
      END IF
      !search for upper and lower value to interpolate between
      DO i = 1, tab % noRows
        IF ( StringToFloat (colIn % row (i)) <= valueIn .AND. &
             StringToFloat (colIn % row (i+1)) >= valueIn      ) THEN 
          lowerIn  = StringToFloat ( colIn % row (i) )
          upperIn  = StringToFloat ( colIn % row (i+1) )
          lowerOut = StringToDouble ( colOut % row (i) )
          upperOut = StringToDouble ( colOut % row (i+1) )
          EXIT  
        END IF
      END DO
      valueOut = LinearInterp ( lowerIn, upperIn, lowerOut, upperOut, valueIn ) 
    ELSE
      SELECT CASE ( StringToUpper (bound) )
        CASE ('FIXED')
          IF ( StringToFloat (colIn % row (1)) > valueIn .OR. &
               StringToFloat (colIn % row (tab % noRows) ) < valueIn ) THEN
            CALL Catch ('error', 'TableLib', 'bounds exceeded in table: ',  &
			             argument = TRIM(tab % Id) )
          END IF
          !search for upper and lower value to interpolate between
          DO i = 1, tab % noRows
            IF ( StringToFloat (colIn % row (i)) <= valueIn .AND. &
                 StringToFloat (colIn % row (i+1)) >= valueIn      ) THEN 
               lowerIn  = StringToFloat ( colIn % row (i) )
               upperIn  = StringToFloat ( colIn % row (i+1) )
               lowerOut = StringToDouble ( colOut % row (i) )
               upperOut = StringToDouble ( colOut % row (i+1) )
               EXIT  
            END IF
          END DO
          valueOut = LinearInterp ( lowerIn, upperIn, lowerOut, upperOut, valueIn )  
        CASE ('EXTENDLINEAR')
          !If value exceed lower bound
          IF ( StringToFloat (colIn % row (1)) >= valueIn ) THEN 
            lowerIn  = StringToFloat ( colIn  % row (1) )
            upperIn  = StringToFloat ( colIn  % row (2) )
            lowerOut = StringToDouble ( colOut % row (1) )
            upperOut = StringToDouble ( colOut % row (2) )
            !calculate interpolation
            valueOut = LinearInterp ( lowerIn, upperIn, lowerOut, upperOut, valueIn ) 
            CALL Catch ('warning', 'TableLib',   &
                        'value is under lower bound: extending linearly')
          !if value exceed upper bound  
          ELSE IF ( StringToFloat (colIn % row (tab % noRows)) <= valueIn ) THEN
            lowerIn  = StringToFloat ( colIn  % row ( tab % noRows - 1) )
            upperIn  = StringToFloat ( colIn  % row ( tab % noRows    ) )
            lowerOut = StringToDouble ( colOut % row ( tab % noRows - 1) )
            upperOut = StringToDouble ( colOut % row ( tab % noRows    ) )
            !calculate interpolation
            valueOut = LinearInterp ( lowerIn, upperIn, lowerOut, upperOut, valueIn )
            CALL Catch ('warning', 'TableLib',   &
                        'value is over upper bound: extending linearly')
          ELSE !value is between the boundary of the table 
            !search for upper and lower value to interpolate between
            DO i = 1, tab % noRows
              IF ( StringToFloat (colIn % row (i)) <= valueIn .AND. &
                   StringToFloat (colIn % row (i+1)) >= valueIn      ) THEN 
                lowerIn  = StringToFloat ( colIn % row (i) )
                upperIn  = StringToFloat ( colIn % row (i+1) )
                lowerOut = StringToDouble ( colOut % row (i) )
                upperOut = StringToDouble ( colOut % row (i+1) )
                EXIT  
              END IF
            END DO
            valueOut = LinearInterp ( lowerIn, upperIn, lowerOut, upperOut, valueIn )  
          END IF        
          
        CASE ('EXTENDCONSTANT')    
          !If value exceed lower bound
          IF ( StringToFloat (colIn % row (1)) >= valueIn ) THEN 
            valueOut = StringToDouble (colOut % row (1)) 
            CALL Catch ('warning', 'TableLib',   &
                        'value is under lower bound: extending constantly')
          !if value exceed upper bound  
          ELSE IF ( StringToFloat (colIn % row (tab % noRows)) <= valueIn ) THEN
            valueOut = StringToFloat (colOut % row (tab % noRows))
            CALL Catch ('warning', 'TableLib',   &
                        'value is over upper bound: extending constantly')
          ELSE !value is between the boundary of the table 
            !search for upper and lower value to interpolate between
            DO i = 1, tab % noRows
              IF ( StringToFloat (colIn % row (i)) <= valueIn .AND. &
                   StringToFloat (colIn % row (i+1)) >= valueIn      ) THEN 
                lowerIn  = StringToFloat ( colIn % row (i) )
                upperIn  = StringToFloat ( colIn % row (i+1) )
                lowerOut = StringToDouble ( colOut % row (i) )
                upperOut = StringToDouble ( colOut % row (i+1) )
                EXIT  
              END IF
            END DO
            valueOut = LinearInterp ( lowerIn, upperIn, lowerOut, upperOut, valueIn )  
          END IF       
        CASE DEFAULT
          CALL Catch ('error', 'TableLib',   &
                      'unknown option in call to TableGetValue: ' ,  &
			          code = unknownOption, argument = TRIM(bound) )
      END SELECT
    END IF
  CASE ('NEAREST')
    !bound method is not necessary, only fixed makes sense.
    bias = HUGE (bias) !initializa bias to biggest number
    DO i = 1, tab % noRows
      IF ( ABS ( StringToFloat (colIn % row (i)) - valueIn ) < bias ) THEN 
        bias = ABS ( StringToFloat (colIn % row (i)) - valueIn )
        valueOut = StringToDouble (colOut % row (i))      
      END IF
    END DO
  CASE DEFAULT
    CALL Catch ('error', 'TableLib',   &
           'unknown option in call to TableGetValue: ' ,  &
			code = unknownOption, argument = TRIM(match) )
END SELECT


END SUBROUTINE TableGetDouble